Setup
In order to perform our exploratory analysis, we will use four packages:
tidyverse: for data reading and editing
usmap: for charting US county data
gganimate: for animating charts
scales: to change the scales of charts
library(tidyverse)
# library(sf)
library(usmap)
library(gganimate)
library(scales)
Attaching package: ‘scales’
The following object is masked from ‘package:purrr’:
discard
The following object is masked from ‘package:readr’:
col_factor
The data for this analysis is published by the Federal Communications Commission (FCC). It has been aggregated from Form 477, where Internet Service Providers (ISPs) are mandated to self-report their internet coverage twice yearly. In particular, I’m using the Area Table available for download on the FCC broadband data website.
df_county <- read_rds("../data/fcc/data_export.rds")
# us_county <- usmap::us_map(region = "counties")
Cleaning
For this analysis we are interested in the percent of people per county who have two or more providers available at a given speed. We do not have information on how ISPs price their service; in theory, the availability of two or more providers at a speed point would create some degree of competitive pricing and make the product minimally accessible.
df_clean <- mutate(df_county, across(c(speed, starts_with("has")), as.numeric)) %>%
group_by(date, id, speed) %>%
summarise(across(where(is.numeric), sum)) %>%
rowwise() %>%
mutate(pop = sum(c_across(starts_with("has")))) %>%
mutate(has_2more = has_2 + has_3more,
pct_2more = has_2more / pop) %>%
rename(fips = id)
`summarise()` has grouped output by 'date', 'id'. You can override using the `.groups` argument.
Plotting
The first set of charts looks at the percent of residents in each county who can purchase internet at 25 mbps download (the FCC definition of “high speed internet”) from 2+ ISPs from 2016-2020. While coverage was sparse in 2016, by 2020 it is nearly universally available.
fmt_title <- function(title, speed) {
str_c("Percent of Residents Eligible for 2+ ISPs at ",
speed,
", ",
date_format("%B %Y")(title))
}
plot_fcc <- function(data, title, speed) {
plot_usmap(data = data, values = "pct_2more") +
scale_fill_viridis_c(label = scales::percent) +
labs(title = fmt_title(title, speed),
fill = NULL) +
theme(legend.position = "right")
}
filter(df_clean, speed == 25) %>%
group_nest(date) %>%
mutate(date = lubridate::my(date)) %>%
arrange(date) %>%
pmap(~plot_fcc(..2, ..1, "25 mbps"))
[[1]]
[[2]]
[[3]]
[[4]]
[[5]]
[[6]]
[[7]]
[[8]]
[[9]]









However, many sites on the internet agree that 25mbps is not sufficient for working or learning from home. They recommend purchasing internet that is 50-100 mbps. These charts show that while there has been an increase in availability of 100mbps internet, it is far from universally available, especially in more rural parts of the country.
filter(df_clean, speed == 100) %>%
group_nest(date) %>%
mutate(date = lubridate::my(date)) %>%
arrange(date) %>%
pmap(~plot_fcc(..2, ..1, "100 mbps"))
[[1]]
[[2]]
[[3]]
[[4]]
[[5]]
[[6]]
[[7]]
[[8]]
[[9]]









LS0tCnRpdGxlOiAiQnJvYWRiYW5kIEFjY2VzcyBpbiB0aGUgVW5pdGVkIFN0YXRlcywgMjAxNi0yMDIwIgphdXRob3I6ICJyZW5hdGEgZ2VyZWNrZSIKc3VidGl0bGU6IEV4cGxvcmF0b3J5IERhdGEgQW5hbHlzaXMKb3V0cHV0OgogIGh0bWxfZG9jdW1lbnQ6CiAgICBkZl9wcmludDogcGFnZWQKLS0tCgojIFNldHVwCgpJbiBvcmRlciB0byBwZXJmb3JtIG91ciBleHBsb3JhdG9yeSBhbmFseXNpcywgd2Ugd2lsbCB1c2UgZm91ciBwYWNrYWdlczogCgotIGB0aWR5dmVyc2VgOiBmb3IgZGF0YSByZWFkaW5nIGFuZCBlZGl0aW5nCi0gYHVzbWFwYDogZm9yIGNoYXJ0aW5nIFVTIGNvdW50eSBkYXRhCi0gYGdnYW5pbWF0ZWA6IGZvciBhbmltYXRpbmcgY2hhcnRzCi0gYHNjYWxlc2A6IHRvIGNoYW5nZSB0aGUgc2NhbGVzIG9mIGNoYXJ0cwoKYGBge3Igc2V0dXB9CmxpYnJhcnkodGlkeXZlcnNlKQojIGxpYnJhcnkoc2YpCmxpYnJhcnkodXNtYXApCmxpYnJhcnkoZ2dhbmltYXRlKQpsaWJyYXJ5KHNjYWxlcykKCmtuaXRyOjpvcHRzX2NodW5rJHNldCgKICAgIG1lc3NhZ2UgPSBGQUxTRQopCmBgYAoKVGhlIGRhdGEgZm9yIHRoaXMgYW5hbHlzaXMgaXMgcHVibGlzaGVkIGJ5IHRoZSBGZWRlcmFsIENvbW11bmljYXRpb25zIENvbW1pc3Npb24gKEZDQykuIEl0IGhhcyBiZWVuIGFnZ3JlZ2F0ZWQgZnJvbSBGb3JtIDQ3Nywgd2hlcmUgSW50ZXJuZXQgU2VydmljZSBQcm92aWRlcnMgKElTUHMpIGFyZSBtYW5kYXRlZCB0byBzZWxmLXJlcG9ydCB0aGVpciBpbnRlcm5ldCBjb3ZlcmFnZSB0d2ljZSB5ZWFybHkuIEluIHBhcnRpY3VsYXIsIEknbSB1c2luZyB0aGUgYEFyZWEgVGFibGVgIGF2YWlsYWJsZSBmb3IgZG93bmxvYWQgb24gIFt0aGUgRkNDIGJyb2FkYmFuZCBkYXRhIHdlYnNpdGVdKGh0dHBzOi8vYnJvYWRiYW5kbWFwLmZjYy5nb3YvIy9kYXRhLWRvd25sb2FkKS4KCmBgYHtyIHJlYWQgZGF0YX0KZGZfY291bnR5IDwtIHJlYWRfcmRzKCIuLi9kYXRhL2ZjYy9kYXRhX2V4cG9ydC5yZHMiKQojIHVzX2NvdW50eSA8LSB1c21hcDo6dXNfbWFwKHJlZ2lvbiA9ICJjb3VudGllcyIpCmBgYAoKIyBDbGVhbmluZwoKRm9yIHRoaXMgYW5hbHlzaXMgd2UgYXJlIGludGVyZXN0ZWQgaW4gdGhlIHBlcmNlbnQgb2YgcGVvcGxlIHBlciBjb3VudHkgd2hvIGhhdmUgdHdvIG9yIG1vcmUgcHJvdmlkZXJzIGF2YWlsYWJsZSBhdCBhIGdpdmVuIHNwZWVkLiBXZSBkbyBub3QgaGF2ZSBpbmZvcm1hdGlvbiBvbiBob3cgSVNQcyBwcmljZSB0aGVpciBzZXJ2aWNlOyBpbiB0aGVvcnksIHRoZSBhdmFpbGFiaWxpdHkgb2YgdHdvIG9yIG1vcmUgcHJvdmlkZXJzIGF0IGEgc3BlZWQgcG9pbnQgd291bGQgY3JlYXRlIHNvbWUgZGVncmVlIG9mIGNvbXBldGl0aXZlIHByaWNpbmcgYW5kIG1ha2UgdGhlIHByb2R1Y3QgbWluaW1hbGx5IGFjY2Vzc2libGUuIAoKYGBge3IgY2xlYW4gZmNjIGRhdGF9CmRmX2NsZWFuIDwtIG11dGF0ZShkZl9jb3VudHksIGFjcm9zcyhjKHNwZWVkLCBzdGFydHNfd2l0aCgiaGFzIikpLCBhcy5udW1lcmljKSkgJT4lCiAgICBncm91cF9ieShkYXRlLCBpZCwgc3BlZWQpICU+JQogICAgc3VtbWFyaXNlKGFjcm9zcyh3aGVyZShpcy5udW1lcmljKSwgc3VtKSwgLmdyb3VwcyA9ICJkcm9wIikgJT4lCiAgICByb3d3aXNlKCkgJT4lCiAgICBtdXRhdGUocG9wID0gc3VtKGNfYWNyb3NzKHN0YXJ0c193aXRoKCJoYXMiKSkpKSAlPiUKICAgIHVuZ3JvdXAoKSAlPiUKICAgIG11dGF0ZShoYXNfMm1vcmUgPSBoYXNfMiArIGhhc18zbW9yZSwKICAgICAgICAgICBwY3RfMm1vcmUgPSBoYXNfMm1vcmUgLyBwb3ApICU+JQogICAgcmVuYW1lKGZpcHMgPSBpZCkgCmBgYAoKIyBQbG90dGluZwoKVGhlIGZpcnN0IHNldCBvZiBjaGFydHMgbG9va3MgYXQgdGhlIHBlcmNlbnQgb2YgcmVzaWRlbnRzIGluIGVhY2ggY291bnR5IHdobyBjYW4gcHVyY2hhc2UgaW50ZXJuZXQgYXQgMjUgbWJwcyBkb3dubG9hZCAodGhlIEZDQyBkZWZpbml0aW9uIG9mICJoaWdoIHNwZWVkIGludGVybmV0IikgZnJvbSAyKyBJU1BzIGZyb20gMjAxNi0yMDIwLiBXaGlsZSBjb3ZlcmFnZSB3YXMgc3BhcnNlIGluIDIwMTYsIGJ5IDIwMjAgaXQgaXMgbmVhcmx5IHVuaXZlcnNhbGx5IGF2YWlsYWJsZS4KCmBgYHtyIGluZGl2aWR1YWwgbWFwcyBtaW4gMjVtYiB1cH0KZm10X3RpdGxlIDwtIGZ1bmN0aW9uKHRpdGxlLCBzcGVlZCkgewogICAgc3RyX2MoIlBlcmNlbnQgb2YgUmVzaWRlbnRzIEVsaWdpYmxlIGZvciAyKyBJU1BzIGF0ICIsCiAgICAgICAgICBzcGVlZCwKICAgICAgICAgICIsICIsCiAgICAgICAgICBkYXRlX2Zvcm1hdCgiJUIgJVkiKSh0aXRsZSkpCn0KCnBsb3RfZmNjIDwtIGZ1bmN0aW9uKGRhdGEsIHRpdGxlLCBzcGVlZCkgewogICAgcGxvdF91c21hcChkYXRhID0gZGF0YSwgdmFsdWVzID0gInBjdF8ybW9yZSIpICsKICAgICAgICBzY2FsZV9maWxsX3ZpcmlkaXNfYyhsYWJlbCA9IHNjYWxlczo6cGVyY2VudCkgKyAKICAgICAgICBsYWJzKHRpdGxlID0gZm10X3RpdGxlKHRpdGxlLCBzcGVlZCksCiAgICAgICAgICAgICBmaWxsID0gTlVMTCwKICAgICAgICAgICAgIGNhcHRpb24gPSAiU291cmNlOiBGQ0MgRm9ybSA0NzcgQWdncmVnYXRlIEFyZWEgVGFibGVzIikgKyAKICAgICAgICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAicmlnaHQiKQp9CgpmaWx0ZXIoZGZfY2xlYW4sIHNwZWVkID09IDI1KSAlPiUKICAgIGdyb3VwX25lc3QoZGF0ZSkgJT4lCiAgICBtdXRhdGUoZGF0ZSA9IGx1YnJpZGF0ZTo6bXkoZGF0ZSkpICU+JQogICAgYXJyYW5nZShkYXRlKSAlPiUKICAgIHB3YWxrKH5wbG90X2ZjYyguLjIsIC4uMSwgIjI1IG1icHMiKSkKCgoKYGBgCgoKSG93ZXZlciwgbWFueSBzaXRlcyBvbiB0aGUgaW50ZXJuZXQgYWdyZWUgdGhhdCAyNW1icHMgaXMgbm90IHN1ZmZpY2llbnQgZm9yIHdvcmtpbmcgb3IgbGVhcm5pbmcgZnJvbSBob21lLiBUaGV5IHJlY29tbWVuZCBwdXJjaGFzaW5nIGludGVybmV0IHRoYXQgaXMgNTAtMTAwIG1icHMuIFRoZXNlIGNoYXJ0cyBzaG93IHRoYXQgd2hpbGUgdGhlcmUgaGFzIGJlZW4gYW4gaW5jcmVhc2UgaW4gYXZhaWxhYmlsaXR5IG9mIDEwMG1icHMgaW50ZXJuZXQsIGl0IGlzIGZhciBmcm9tIHVuaXZlcnNhbGx5IGF2YWlsYWJsZSwgZXNwZWNpYWxseSBpbiBtb3JlIHJ1cmFsIHBhcnRzIG9mIHRoZSBjb3VudHJ5LgoKYGBge3IgaW5kaXZpZHVhbCBtYXBzIG1pbiAxMDAgbWIgdXB9CmZpbHRlcihkZl9jbGVhbiwgc3BlZWQgPT0gMTAwKSAlPiUKICAgIGdyb3VwX25lc3QoZGF0ZSkgJT4lCiAgICBtdXRhdGUoZGF0ZSA9IGx1YnJpZGF0ZTo6bXkoZGF0ZSkpICU+JQogICAgYXJyYW5nZShkYXRlKSAlPiUKICAgIHB3YWxrKH5wbG90X2ZjYyguLjIsIC4uMSwgIjEwMCBtYnBzIikpCmBgYAoK